home *** CD-ROM | disk | FTP | other *** search
/ CD-ROM Data 2002 May / CD Rom Data Mayıs 2002.iso / Freeware / Blitz Basic / data1.cab / Support / help / samples / netgame.bb < prev    next >
Encoding:
Text File  |  2002-04-10  |  4.6 KB  |  236 lines
  1.  
  2. ;Very simple demo showing the basics of a network game
  3. ; Verified 1.48 compliant: 4/18/2001
  4. AppTitle "Blitz Multiplayer demo"
  5.  
  6. Const width=640,height=480
  7.  
  8. Global send_freq=5    ;send every fifth update
  9. Global smoothing=5
  10. Global Ping_time
  11.  
  12. Type Info
  13.     Field txt$
  14. End Type
  15.  
  16. Type Player
  17.     Field x#,y#,r#        ;where ship appears on screen
  18.     Field dx#,dy#,dr#    ;speeds - (recvd pos-current pos)/smoothing
  19.     Field name$,net_id
  20.     
  21. End Type
  22.  
  23. If Not StartNetGame() Then End
  24.  
  25. Graphics width,height
  26.  
  27. send_cnt=1
  28.  
  29. ;get player name
  30. Repeat
  31.     Cls
  32.     Color 0,48,0
  33.     For x=0 To width-1 Step 32
  34.         Rect x,0,1,height
  35.     Next
  36.     For y=0 To height-1 Step 32
  37.         Rect 0,y,width,1
  38.     Next
  39.     Color 255,255,255
  40.     Locate 16,height/4
  41.     name$=Input$( "Player name? " )
  42. Until name$<>""
  43.  
  44. ;create a local player
  45. Global player.Player=New Player
  46. player\x=width/2
  47. player\y=height/2
  48. player\r=0
  49. player\name=name$
  50. player\net_id=CreateNetPlayer( name$ )
  51.  
  52. Global chat$
  53.  
  54. SetBuffer BackBuffer()
  55.  
  56. While Not KeyDown(1)
  57.  
  58.     UpdateNetwork()
  59.     
  60.     send_cnt=send_cnt-1
  61.     If send_cnt=0
  62.         send_cnt=send_freq
  63.         send=True
  64.     Else
  65.         send=False
  66.     EndIf
  67.     
  68.     UpdatePlayers( send )
  69.     
  70.     RenderAll()
  71.     
  72.     Flip
  73. Wend
  74.  
  75. End
  76.  
  77. ;update incoming network messages...
  78. Function UpdateNetwork()
  79.     While RecvNetMsg()
  80.         Select NetMsgType()
  81.         Case 1:
  82.             p.Player=FindPlayer( NetMsgFrom() )
  83.             If p<>Null Then UnpackPlayerMsg( NetMsgData$(),p )
  84.         Case 2:
  85.             info( NetPlayerName$( NetMsgFrom() )+":"+NetMsgData$() )
  86.         Case 3:
  87.             SendNetMsg 4,"Pong!",player\net_id,0,0
  88.         Case 4:
  89.             t=MilliSecs()-Ping_time
  90.             info( "Ping: "+t+"ms" )
  91.         Case 100:
  92.             p.Player=New Player
  93.             p\net_id=NetMsgFrom()
  94.             p\name=NetPlayerName$( NetMsgFrom() )
  95.             info( p\name+" has joined the game. " )
  96.         Case 101:
  97.             p.Player=FindPlayer( NetMsgFrom() )
  98.             If p<>Null
  99.                 info( p\name+" has left the game. " )
  100.                 Delete p
  101.             EndIf
  102.         Case 102:
  103.             info( "I'm the new host! " )
  104.         Case 200:
  105.             EndGraphics
  106.             Print "The session has been lost!"
  107.             WaitKey
  108.             End
  109.         End Select
  110.     Wend
  111. End Function
  112.  
  113. Function UpdatePlayers( send )
  114.  
  115.     If KeyHit(59)
  116.         Ping_time=MilliSecs()                
  117.         SendNetMsg 3,"Ping!",player\net_id,0,0
  118.     EndIf
  119.     If KeyHit(60) And send_freq>0 Then send_freq=send_freq-1
  120.     If KeyHit(61) Then send_freq=send_freq+1
  121.     If KeyHit(62) And smoothing>0 Then smoothing=smoothing-1
  122.     If KeyHit(63) Then smoothing=smoothing+1
  123.     
  124.     For p.Player=Each Player
  125.         If NetPlayerLocal( p\net_id )
  126.         
  127.             ;L/R rotation
  128.             If KeyDown( 203 )
  129.                 p\r=p\r-5
  130.             Else If KeyDown( 205 )
  131.                 p\r=p\r+5
  132.             EndIf
  133.             
  134.             ;Thrust
  135.             If KeyDown( 200 )
  136.                 p\x=p\x+Cos(p\r)*5
  137.                 p\y=p\y+Sin(p\r)*5
  138.             EndIf
  139.             
  140.             ;Chat stuff
  141.             key=GetKey()
  142.             If key
  143.                 If key=13
  144.                     If chat$<>"" SendNetMsg 2,chat$,p\net_id,0,0
  145.                     chat$=""
  146.                 Else If key=8
  147.                     If Len(chat$)>0 Then chat$=Left$(chat$,Len(chat$)-1)
  148.                 Else If key>=32 And key<127
  149.                     chat$=chat$+Chr$(key)
  150.                 EndIf
  151.             EndIf
  152.             
  153.             ;transmit player position and rot
  154.             If send
  155.                 SendNetMsg 1,PackPlayerMsg$(p),p\net_id,0,0
  156.             EndIf
  157.         Else
  158.             p\x=p\x+p\dx
  159.             p\y=p\y+p\dy
  160.             p\r=p\r+p\dr
  161.         EndIf
  162.     Next
  163. End Function
  164.  
  165. Function RenderPlayers()
  166.     For p.Player=Each Player
  167.         x1=p\x+Cos(p\r)*8
  168.         y1=p\y+Sin(p\r)*8
  169.         x2=p\x+Cos(p\r+150)*8
  170.         y2=p\y+Sin(p\r+150)*8
  171.         x3=p\x+Cos(p\r-150)*8
  172.         y3=p\y+Sin(p\r-150)*8
  173.         
  174.         Color 255,255,255
  175.         Line x1,y1,x2,y2:Line x2,y2,x3,y3:Line x3,y3,x1,y1
  176.         
  177.         Color 0,0,255
  178.         Text p\x+12,p\y,p\name,0,1
  179.     Next
  180.     
  181. End Function
  182.  
  183. Function info( t$ )
  184.     i.Info=New Info
  185.     i\txt$=t$
  186.     Insert i Before First Info
  187. End Function
  188.  
  189. Function RenderAll()
  190.     ;render everything!
  191.     Cls
  192.     Color 0,255,0
  193.     Text 0,FontHeight()*0,"Multiplayer!"
  194.     Text 0,FontHeight()*1,"F1:ping, type to chat"
  195.     Text 0,FontHeight()*2,"Send freq:"+send_freq+" (F2-, F3+)"
  196.     Text 0,FontHeight()*3,"Smoothing:"+smoothing+" (F4-, F5+)"
  197.     Text 0,FontHeight()*4,">"+chat$
  198.     y=FontHeight()*5
  199.     r=255
  200.     For i.Info=Each Info
  201.         If r>0
  202.             Color r,r/2,0
  203.             Text 0,y,i\txt$
  204.             y=y+FontHeight()
  205.             r=r-12
  206.         Else
  207.             Delete i
  208.         EndIf
  209.     Next
  210.     
  211.     RenderPlayers()
  212.     
  213. End Function
  214.  
  215. ;pack player details into a string.
  216. ;Not very elegant at present...more funcs coming!
  217. Function PackPlayerMsg$( p.Player )
  218.     Return LSet$( Int(p\x),6 )+LSet$( Int(p\y),6 )+LSet$( Int(p\r),6 )
  219. End Function
  220.  
  221. ;unpack player details from a string
  222. Function UnpackPlayerMsg( msg$,p.Player )
  223.     x=Mid$( msg$,1,6 )
  224.     y=Mid$( msg$,7,6 )
  225.     r=Mid$( msg$,13,6 )
  226.     p\dx=(x-p\x)/smoothing
  227.     p\dy=(y-p\y)/smoothing
  228.     p\dr=(r-p\r)/smoothing
  229. End Function
  230.  
  231. ;find player with player id
  232. Function FindPlayer.Player( id )
  233.     For p.Player=Each Player
  234.         If p\net_id=id Then Return p
  235.     Next
  236. End Function